perm filename S1[F8,ALS] blob sn#323389 filedate 1977-12-22 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	* CHECKERS as of DECEMBER  16 1977 0900 hours
C00008 00003	*-*- INITIAL SET-UP
C00016 00004	*Player's move
C00026 00005	*-*-*- Message writing, uses R0, 1, SC O'24'
C00032 00006	*-*-*- Read keyboard
C00040 00007	* UPDATE CONTROL DATA *
C00051 00008	*-*-*- Data for byte values (X coord. conversions)
C00062 00009	*MWAD*-WAIT, THEN UPDATE, AND KEEP THE*
C00071 00010	*DEBUGING AID*-*-TEMPORARY ONLY!
C00076 ENDMK
C⊗;
* CHECKERS as of DECEMBER  16 1977 0900 hours
* Resident package addresses
JOYT    EQU  H'0C00'
LINE    EQU  H'0FDF'
SHCB    EQU  H'0FE2'
INPF    EQU  H'0FE3'
WTLN    EQU  H'0FE5'
TXC     EQU  H'0FE8'
CMRG    EQU  H'0FEA'
DBNC    EQU  H'0FEB'
UPI     EQU  H'0FFA'
JOYI    EQU  H'21AD'
IJS     EQU  H'22DB'
SHL     EQU  H'27C6'
SHR     EQU  H'27D3'
PUSH    EQU  H'40A9'
POPS    EQU  H'40BC'
SPS     EQU  H'40D0'
WDG     EQU  H'4105'
WAUD    EQU  H'41C8'
WAU1    EQU  H'41CC'
CDS     EQU  H'41D5'
WMS     EQU  H'4205'
UDAT    EQU  H'424D'
TRAN    EQU  H'43CD'
FCS     EQU  H'43D6'
WAIT    EQU  H'4501'
TIR     EQU  H'45DB'
CLER    EQU  H'4762'
*Misc. constants
TCMD    EQU  H'44'
BCMD    EQU  H'6D'
TCOL    EQU  H'80'   TEXT COLOR
ULIN    EQU  H'FA'
COM     EQU  H'8F7'
*RAM assignments
BFLG    EQU  H'0C20' BUTTON EDGE FLAG
BLNF    EQU  H'0C21' Blink flag
XBLN    EQU  H'0C22' X value to blink
YBLN    EQU  H'0C23' Y value to blink
BCNT    EQU  H'0C24' Counter used in OKMV
BKMV    EQU  H'0C25' Data to index book moves
HSAV    EQU  H'0C26' H save location
PLY0    EQU  H'0C28' Place for player's ply depth choice
COL0    EQU  H'0C29' Place for color choice(next after PLY0)
SELX    EQU  H'0C2A' SELE exit (0 norm, 1 M's 1st, -1 P's 1st)
XOLD    EQU  H'0C2D' XCOORD TOUCH POINT (DOUBLE JUMP)
YOLD    EQU  H'0C2E' YCOORD TOUCH POINT (DOUBLE JUMP)
OBJ0    EQU  H'0C30' Board 1, thru H'0E0F'
TREE    EQU  H'0E10' Tree data, thru H'0EFF', Player's board f
TRE2    EQU  H'0E20' Machine's first board here
PLDJ    EQU  H'0E57' USED FOR TEMP STORE OF TOUCH POINT
PLMD    EQU  H'0E5B' Used for temp store of player's move inf
PLMV    EQU  H'0ED0' Overlay region used for player's moves
PLMF    EQU  H'0EE0' and move numbers
SCOR    EQU  H'0EF0' SCORE (HI:LO) 14 2 BYTE PAIRS
XPOS    EQU  H'0F0C' XPOSITION(CURSOR)
YPOS    EQU  H'0F0F' YPOSITION(CURSOR)
OBJ1    EQU  H'0F10' Board 2, thru H'0FAF'
MOBS    EQU  H'0FB0' Mobility (14 bytes)
RGSV    EQU  H'0FC8' Register save start (int. update)
*Scratch pad assignments
TEMP    EQU  H'8'
J       EQU  H'9'
HU      EQU  H'A'
HL      EQU  H'B'
PLOC    EQU  O'3'    LISU value for ACTIVE and PASSIVE
KLOC    EQU  O'4'    LISU value for KING's and special data
ELOC    EQU  O'5'    LISU value for EMPTY's area
ISA     EQU  O'30'   ISAR value for active area
ISP     EQU  O'34'   ISAR value for passive
ISK     EQU  O'40'   ISAR value for kings
ACTM    EQU  O'46'   ISAR VALUE FOR ACTIVE MATERIAL
PASM    EQU  O'47'   ISAR VALUE FOR PASSIVE MATERIAL
ISE     EQU  O'51'   ISAR value foempty (with offset)
*Mimimum ply depths
PLYT    EQU  H'E9'   Playing depth for Tom (neg mob sum)
PLYD    EQU  H'E1'   Playing depth for Dick
PLYH    EQU  H'D9'   Playing depth for Harry
*SPECIAL CONSTANTS
MSK     EQU  H'1'    X ZOOM BIT MASK (CMRG)
X       EQU  H'1'
Y       EQU  H'2'
VX      EQU  H'3'
VY      EQU  H'4'
CHT     EQU  H'3'    CURSOR HEIGHT
YTST    EQU  H'9'
XZOP    EQU  H'34'   LINE FOR RESTORE OF X ZOOM
MAXY    EQU  H'4D'   MAX Y COORD (=H'4F'-CHT)
*Linkage locations
SELE    EQU  H'1790'
        ORG  H'1000' Initial operations and questions
        DC   H'AA'
        DC   H'55'
        DC   H'00'   BACKGROUND COLOR
        DC   H'00'   BACKGROUND COLOR
        DC   H'00'   SPACES
        DC   H'00'   SPACES
        DC   H'3119' CH
        DC   H'0B31' EC
        DC   H'150B' KE
        DC   H'0921' RS
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
*-*- INITIAL SET-UP
        PI   CDS     CLEAR DISPLAY
        PI   IJS     INITIALIZE JOYSTICK TABLE
        LISU 2       For safety only, can be removed later
        LISL 6
        CLR
        XS   S
        BM   QN1     Is clock running?
        LI   H'81'   No, so start it
        LR   D,A
        LIS  2
        LR   S,A
*-*-*-*- Initial question session
QN1     LIS  H'4'
        LR   0,A
        PI   SEDC    SET MESSAGE LNGTH&LINE POINTER
        DCI  SKL
        PI   WMS     WRITE MESSAGE
        PI   RKB     AND DO KEYBOARD READ
        CI   H'2D'
        BZ   QN10    Is it Betty?
        CI   H'31'   NO.
        BZ   QN9     Is it Charlie?
        LI   PLYT    Then it's Abe
        BR   QN11
QN9     LI   PLYH    It's Charlie
        BR   QN11
QN10    LI   PLYD    It's Betty
QN11    DCI  PLY0
        ST           SAVE IT.
        DS   0
        DS   0       SET FOR BUT TWO LINES
        PI   CDS     CLEAR DISPLAY
        PI   SEDC    SET LINE POINTER
        LIS  H'5'
        COM
        AS   S
        LR   S,A     SET FOR BUT H'1A' LENGTH
        DCI  YMF     DCO TO MESSAGE START
        PI   WMS     SO WRITE MESSAGE
        PI   RKB     READ KEYBOARD
        CI   H'2B'   Is answer an N?
        DCI  COL0
        CLR
        LR   7,A     Black plays first always
        BZ   QN13    N means machine first
        COM
        ST           COL0<=-1, player is black
        COM
        ST           SELX<=??, player first
        BR   QN14
QN13    ST           COL0<=0, machine is black
        ST           SELX<=??, machine first
QN14    DCI  BLKM    TABLE OF POSSIBLE MOVES
        XDC
        DCI  PLMV    List to verify moves
        LIS  H'7'
        LISU 2
        LISL 0
        LR   S,A     SET TRANSFER COUNT
        PI   TRAN    DO TRANSFER
        DCI  BKMV
        CLR
        ST           Clear Book move index value
        DCI  CMRG
        LI   H'65'
        ST           SET FOR X & Y ZOOM
        PI   CLER    TURN OFF CURRENT OBJECTS
        DCI  UPI     DCO TO UPDATE CONTROLS
        LIS  H'3'
        ST           SET INTO COUNT
        CLR
        ST           SET FOR FULL INIT
        LI   INIT:
        ST
        LI   INIT.
        ST           AND SET ADDRESS
        PI   MWAD    WAIT, THEN UPDATE
        LIS  H'5'
        LR   S,A     GET TRANSFER COUNT
        DCI  BDAT    SET SOURCE
        XDC          INTO DC1
        DCI  UPI+1   DESTINATION
        PI   TRAN    TRANSFER DATA
        PI   WAUD    Wait then update
        PI   ENIN    NOW ENABLE INTERRUPT
*-*-*- Load SC for initial board
        LISU PLOC    LOAD SCRATCHPAD AS
        LISL 7       FOLLOWS:
        CLR
BRDJ    LR   D,A     O'30'=FF
        BR7  BRDJ    O'31'=F0
        COM          O'32'=0
        LR   I,A     O'33'=0
        LR   I,A     O'34'=0
        SL   4       O'35'=0
        LR   I,A     O'36'=F
        LISL 6       O'37'=FF
        LIS  H'F'
        LR   I,A
        LISU KLOC
        LISL H'7'
        CLR
BRDK    LR   D,A     O'40' thru O'47' = 0
        BR7  BRDK
        LI   H'18'   SET PASSIVE AND ACTIVE MATERIAL
        LR   D,A     COUNTS TO H'18'=D'24' INITIALLY
        LR   D,A
        DCI  TRE2
        PI   SCRD    SR to RAM for machine's first move
        DCI  TREE
        PI   SCRD    SR to RAM for player's first move
        PI   BORD    Generate board image with men
        DCI  XPOS
        LIS  H'0'
        ST           SET FOR LEFT MOST
        LIS  H'3'
        ST
        LIS  H'0'
        ST
        DCI  YPOS
        ST           AND SET FOR TOPMOST
*-*-*-*-*-*-*-*-*-*- Start play
        DCI  COL0
        CLR
        XM
        BM   PMOV    Player chose Black
*-*-*- Machine's first move if playing black
        LISU 2
        LISL 5
        LIS  H'7'    Used as random number
        NS   S       Save last 3 bits
        LR   0,A     Use this number to select move
        DCI  BKMV    Book move index
        SL   4       Save space for second move
        SR   1
        ST           Record first move
        DCI  PLMV
QN17    LM           Get byte record
        LR   1,A
QN18    LR   A,1
        NS   1
        BNZ  QN19    Is this byte exhausted?
        LM           Step over byte info
        BR   QN17    Go to next byte record
QN19    LR   2,A
        AI   H'FF'   Subtract 1
        NS   1
        LR   1,A     byte less rightmost bit
        XS   2       This leaves 1 bit in A
        DS   0
        BP   QN18
        LR   6,A     Save the byte bit
        LM           Get the byte info
        LR   4,A     The byte indicator
        DCI  TRE2    Machine's board is here
        LR   H,DC
        LIS  H'C'
        ADC
        LR   A,6
        ST
        LR   A,4
        ST
        JMP  SELE    Go to SELE to make move
*Player's move
*
PMOV    PI   MWAD    Wait, then update
        PI   MVC     Initiate cursor
        DCI  TREE    Player's board is here
        LR   H,DC
MES0    CLR          "YOUR MOVE"
MES1    LR   0,A     Identify message
        PI   WMC     Write message
        DCI  BLNF
        CLR
        ST
CUR1    PI   CURS    Initiate cursor
*-*- Now X in 1, Y in 2, byte in 3 and byte # in 4
OKPI    DCI  PLMV    Possible moves listing
OKP1    CLR
        XM
        BNZ  OKP3    An entry found
        LR   A,5     Byte info
        NI   H'10'   Extract J bit
        LIS  H'5'    "PIECE CAN'T MOVE"
        BZ   OKP2
        LIS  H'1'    "MUST JUMP"
OKP2    BR   MES1    Try again
OKP3    NS   3       Compare
        BNZ  OKP4    This might be the one
        LM           A cheap way to index
        LR   5,A     Save for jump info
        BR   OKP1    Try again
OKP4    LM           Next entry is the byte info
        LR   5,A     Save it
        SR   1
        SR   1
        NI   H'3'    Remove the J bit and the direction
        XS   4       Does it match?
        BNZ  OKP1    Try again
        DCI  PLMD    Save data as to starting square
        LR   A,1     X
        ST
        LR   A,2     Y
        ST
        LR   A,3     BYTE
        ST
        LR   A,4     Byte info
        ST
        LIS  H'3'
        COM
        DCI  BCNT    Counter
        ST
        DCI  BLNF    Blink flag
        LIS  H'1'    Set on
        ST
        LR   A,1     Save X value
        ST           in XBLN
        LR   A,2     Save Y value
        ST           in YBLN
CUR2    PI   CURS
        DCI  PLDJ    STORE POSSIBLE TOUCH POINT
        LR   A,1
        ST
        LR   A,2
        ST
        LR   A,3
        ST
        LR   A,4
        ST
        DCI  PLMD+2  Restore initial values
        LM
        LR   3,A     for BYTE
        LM
        LR   4,A     and BYTE number
*Now test indicated move for legality
OKMV    DCI  PLMD    Saved data location
        LM           Get the old X value
        COM
        INC
        AS   1       This gives us the change in X
        BNZ  OKM01
        JMP  NON2    ILLEGAL
OKM01   LR   1,A     Save the difference
        BP   OKM1
        COM
        INC
OKM1    LR   0,A     |X|
        CI   H'2'
        BP   OKM02
        JMP  NON3    TOO FAR
OKM02   CLR          Anticipate normal move
        BNZ  OKM2
        LI   H'10'   Set Jump bit
OKM2    LR   6,A     save byte info here
        LM           Get the old Y value
        COM
        INC
        AS   2
        LR   2,A     Change in Y
        BM   OKM3
        COM
        INC
OKM3    AS   0
        BNZ  NON2    |X||Y|
        LR   A,2
        NS   2
        BP   OKM4
        LIS  H'2'    Backward bit
        AS   6
        LR   6,A
OKM4    LR   A,1
        NS   1
        BM   OKM5
        LIS  H'1'    Left bit
        AS   6
        LR   6,A
OKM5    LR   A,4     Get initial Byte #
        SL   1       Shift it left to position
        SL   1
        AS   6       Add in the J and Direction bits
        LR   6,A     Final byte info from cursor
        DCI  PLMV    Possible moves listing
        LIS  H'8'    7 moves possible
        LR   0,A
OKM6    CLR
        XM
        BZ   NONO    No more entries
        LR   1,A
        LM
        LR   5,A     Save byte info
OKM7    CLR
        XS   1
        BZ   OKM6    Last bit tested
        LR   2,A     We'll need it again
        AI   H'FF'   Subtract 1
        NS   1
        LR   1,A     Byte with bit removed
        XS   2       Get extracted bit
        DS   0       Count tries
        NS   3       Does it check with 3
        BZ   OKM7    Not in table entry, try again
        LR   A,5     But does byte info agree?
        XS   6       Compare 6 with table value
        BNZ  OKM7    No so count remaining bits in 1
        LIS  H'7'    Found, so reorder count
        XS   0       order from 0 thru 6
        DCI  BKMV
        ST           Save move count for book move entry
        PI   MWAD    DO MY WAIT THEN UPDATE
        PI   MVC     Turn off cursor
        PI   ENIN    NOW ENABLE INTERRUPT
        DCI  TREE    Store final values
        LR   H,DC
        LIS  H'C'
        ADC
        LR   A,3
        ST           Store byte
        LR   A,6
        ST           And byte info
*Before going to SELE, we want to
*set the BLINK coordinates to
*match the "CURRENT" position
        DCI  XBLN    DESTINATION
        XDC          SAVE IN DC1
        DCI  XOLD    DCO TO XPOSITION
        LM           GET SAME
        XDC          GET DESTINATION
        ST           AND SET SAME
        XDC          SAVE NEW DESTINATION
        LM           GET OLD Y POSITION
        XDC
        ST           AND RESET TO BLINK THERE
        DCI  BLNF    DCO TO BLINK FLAG
        LIS  H'1'
        ST           SET FOR BLINK
        JMP  SELE
NONO    LR   A,5
        NI   H'10'   A jump required?
        LIS  H'2'
        BZ   NON4
        LIS  H'1'
        BR   NON4
NON2    LIS  H'2'
        BR   NON4
NON3    LIS  H'3'
NON4    LR   0,A
        DCI  BCNT
        LM
        INC
        DCI  BCNT
        ST
        BM   NON5
       JMP  MES0
NON5    PI   WMC
        JMP  CUR2
DJMP    DCI  BCNT    Set counter for
        LI   H'82'   large # of trials
        ST
        DCI  PLMD
        XDC
        DCI  PLDJ
        LIS  H'4'
        LR   0,A
DJMP1   LM           GET OLD TOUCH POINT DATA
        XDC
        ST           AND TRANSFER TO PLMD
        XDC
        DS   0       DECREMENT COUNT
        BNZ  DJMP1   DONE ENOUGH TRANSFER?
        PI   MWAD    DO MY WAIT, THEN UPDATE
        PI   MVC     TURN CURSOR ON
        LIS  H'6'
        LR   0,A     SET FOR "CONTINUE JUMP" MESSAGE
        BR   NON5    AND DISPLAY SAME
*-*-*- Message writing, uses R0, 1, SC O'24'
* calls UPDATE routine. Message # in 0.
WMC     LR   K,P     SAVE RETURN ADDRESS
        PI   PUSH    PUSH ONTO STACK
        DCI  H'872'
        LI   H'82'
        ST           TURN MESSAGE OBJECT OFF...
        DCI  HSAV
        LR   A,HU
        ST
        LR   A,HL
        ST
        PI   MWAD    WAIT, THEN UPDATE
        DCI  WMCA    DCO TO MESSAGE ADDRESS START
        LR   A,0     GET MESSAGE NUMBER
        SL   1
        AS   0
        ADC          ADD 3XNUMBER TO DCO
        LISU 2
        LISL 4       SET ISAR TO O'24'
        LM
        LR   S,A     SET MESSAGE LENGTH
        LM
        LR   QU,A
        LM
        LR   QL,A    MESSAGE ADDRESS INTO Q
        DCI  LINE
        LIS  H'5'
        SL   4
        ST           SET PROPER LINE NUMBER
        DCI  H'0E5F' DCO TO MESSAGE BUILD AREA
        LIS  H'7'
        SL   4
        LR   1,A     SET COUNTER
        CLR          CLEAR ACC
WMC1    ST
        DS   1
        BNZ  WMC1    CLEAR TEXT AREA
        PI   WAUD    WAIT, THEN DO UPDATE
        DCI  H'872'
        LIS  H'2'
        ST           TURN OBJECT ON
        LR   DC,Q    SET ADDRESS INTO DCO
        PI   WMS     WRITE MESSAGE
        PI   MWAD    WAIT, THEN UPDATE
        DCI  HSAV
        LM
        LR   HU,A
        LM
        LR   HL,A
        PI   ENIN    ENABLE INTERRUPTS ONCE MORE
        PI   POPS    POP RETURN ADDRESS
        PK           AND RETURN
*-*-*-*-*-*-*-*-*-*
* DATA FOR WMC
*
WMCA    DC   H'A'    YOUR MOVE! 0
        DC   YRMV:
        DC   YRMV.
        DC   H'A'    MUST JUMP 1
        DC   MJM:
        DC   MJM.
        DC   H'D'    ILLEGAL MOVE 2
        DC   MIM:
        DC   MIM.
        DC   H'8'    TOO FAR 3
        DC   TFM:
        DC   TFM.
        DC   H'7'    MY MOVE 4
        DC   MYMV:
        DC   MYMV.
        DC   H'10'   PIECE CANNOT MOVE 5
        DC   PCMM:
        DC   PCMM.
        DC   H'D'    CONTINUE JUMP 6
        DC   CJM:
        DC   CJM.
        DC   H'6'    I WIN 7
        DC   IWIN:
        DC   IWIN.
        DC   H'8'    YOU WIN 8
        DC   UWIN:
        DC   UWIN.
YRMV    DC   H'0513' YOur move
        DC   H'0309' UR
        DC   H'0'    SPACE
        DC   H'2913' MO
        DC   H'2F0B' VE
        DC   H'04'   !
MJM     DC   H'2903' MUst jump
        DC   H'2107' ST
        DC   H'0'    SPACE
        DC   H'1703' JU
        DC   H'2925' MP
        DC   H'04'   !
MIM     DC   H'0127' ILlegal move
        DC   H'270B' LE
        DC   H'1B11' GA
        DC   H'2700' L SPACE
        DC   H'2913' MO
        DC   H'2F0B' VE
        DC   H'04'   !
TFM     DC   H'0713' TO far
        DC   H'1300' O SPACE
        DC   H'1D11' FA
        DC   H'0904' R!
MYMV    DC   H'2905' MY move
        DC   H'0'    -
        DC   H'2913' MO
        DC   H'2F0B' VE
PCMM    DC   H'2501' PIece can't move
        DC   H'0B31' EC
        DC   H'0B00' E SPACE
        DC   H'3111' CA
        DC   H'2B39' N'
        DC   H'0700' T SPACE
        DC   H'2913' MO
        DC   H'2F0B' VE
CJM     DC   H'3113' CONTINUE JUMP
        DC   H'2B07'
        DC   H'012B'
        DC   H'030B'
        DC   H'0'
        DC   H'1703'
        DC   H'2925'
IWIN    DC   H'0100' I WIN!
        DC   H'0D01'
        DC   H'2B04'
UWIN    DC   H'0513' YOU WIN!
        DC   H'0300'
        DC   H'0D01'
        DC   H'2B04'
*-*-*- Read keyboard
RKB     LR   K,P     Read keyboard
        PI   PUSH
        LISU 2
        LISL 4       SET ISAR FOR DELAY TIMER
        LIS  H'0'
        LR   S,A     SET FOR MAX DELAY
RKB1    PI   FCS     FETCH CHARACTER
        BZ   RKB1    NULL INPUT?
        BM   RKB1    NO. DEBOUNCED INPUT?
        PI   POPS    YES. POP RETURN ADDRESS
        LR   A,8     GET KEYBOARD INPUT
        PK           AND RETURN
*-*-*- Initial moves for black
BLKM    DC   B'11110000' 4 pieces
        DC   B'00000100' Byte 1, RF
        DC   B'11100000' 3 pieces
        DC   B'00000101' Byte 1, LF
        DC   B'01000000' 11-15 repeat to give
        DC   B'00000100' a slight preference
        DC   H'00'
*-*-*- Generate board image
BORD    LR   K,P
        CLR
        COM
        LR   3,A     REG3=FF
        DCI  OBJ0    BRD1 START ADDRESS
        LIS  H'2'    FLAG FOR BOR
        LR   4,A     SET REG 4 = 2
        LIS  H'6'
BRD4    LR   0,A     REG0 = 6 ROWS
BRD3    LIS  H'A'
        LR   1,A     REG 1 = 10 LINE/ROW
BRD2    LIS  H'4'
        LR   2,A     REG2=SQ PAIRS/ROW
BRD1    LR   A,3
        ST           STORE IN BRD
        COM
        ST           NEXT IS COMPL. OF FIRST
        DS   2
        BNZ  BRD1    MORE FOR THIS ROW
        DS   1       NO, ALL LINE DONE
        BNZ  BRD2
        LR   A,3     DONE A TIMES YET
        COM
        LR   3,A
        DS   0       DEC ROW COUNT
        BNZ  BRD3    ALL ROWS DONE?
        DS   4
        BZ   BRD5    BOTH OBJECTS DONE?
        DCI  OBJ1    NO,GET BORD2 ADDRS.
        LIS  H'2'
        BR   BRD4    REG0=2
*-*-*- Now put pieces in image
BRD5    LISU 3       Pieces are here
        LIS  H'1'    1 for red pieces (stored first)
        LR   4,A     Piece, (1 Red, 0 Black, -1 King)
        DCI  COL0
        CLR          CLEAR ACC
        XM           IN W/STATUS
        LR   0,A
        LISL O'7'    Decrement and shift right
        BNZ  MEN1    if COL0 is FF (BLACK at bottom of scree
        LISL O'0'    Increment and shift left
MEN1    LIS  H'3'    if COL0 is 0 (Black at top of screen)
        LR   1,A     To count bytes
MEN2    LIS  H'7'
        LR   2,A     To count bits
        DCI  TAB1    Byte location table
        LR   A,1     This byte number
        SL   1       Locations occupy 2 bytes each
        ADC
        LM           Get the byte location
        LR   QU,A    and save it in Q
        LM
        LR   QL,A
        LR   A,0
        NS   0
        BNZ  MEN5    Decrement and shift right if COL0 is FF
        LR   A,I     Increment and shift left if COL0 is 0
        BR   MEN4
MEN3    LR   A,3
        SL   1       and shift left
MEN4    LR   3,A
        NI   H'80'   (done this way for symry
        BZ   MEN9
        BR   MEN8
MEN5    LR   A,D     Decrement if COL0 is FF
        BR   MEN7
MEN6    LR   A,3
        SR   1       and shift right
MEN7    LR   3,A
        NI   H'1'
        BZ   MEN9
MEN8    DCI  TAB2    Relative-locations-of-squares table
        LR   A,2     This square
        ADC
        LM           Get square displacement
        LR   DC,Q    Recall the location for the input byte
        ADC          This is the square position
        LR   A,4     Identify type of piece
        NS   4
        BM   PUTK    To put down a king
        LIS  H'4'    Prepare for a piece
        LR   5,A     To count lines
        LI   H'20'   Skip the rst 4 lines (4*8)
        ADC
        XDC
        DCI  BLKP    Anticipate a black piece
        BZ   PUTL    A black piece (status bit still ok)
        DCI  REDP    No, it's a red piece
        BR   PUTL
PUTK    LIS  H'2'    Only 3 lines for a crown
        LR   5,A
        LIS  H'8'    To skip 1 line
        ADC
        XDC
        DCI  KING
PUTL    LM           Put loop
        XDC
        ST
        LIS  H'7'    To next line on screen (less increment)
        ADC
        XDC
        DS   5
        BP   PUTL    Loop
MEN9    DS   2
        BM   ME10
        LR   A,0
        NS   0
        BNZ  MEN6    Shift right if COL0 is FF
        BR   MEN3    Shift left if COL0 is 0
ME10    DS   1
        BP   MEN2
        LR   A,4
        NS   4
        BM   BDEX    Exit from board routine
        DS   4
        BP   MEN1    Go round again for black pieces
        LISU H'4'    Get set for kings
        LR   A,0
        NS   0
        LISL H'3'    Decrementing case
        BNZ  MEN1    Dedrement and shift right if COL0 is FF
        LISL H'0'    Incrementing case
        BR   MEN1    Increment and shift left if COL0 is 0
BDEX    PK
* UPDATE CONTROL DATA *
*
BDAT    DC   H'1'    FLAG SET SHORT UPDATE
        DC   UDIT:
        DC   UDIT.
        DC   UDIT:
        DC   UDIT.
* Set message length and line pointer
SEDC    DCI  LINE    DCO TO LINE POINTER
        LIS  H'2'
        SL   4       SET FOR SECOND LINE
        ST
        LR   A,0
        SL   4
        LISL 4
        LR   S,A     AND SET MESSAGE LENGTH
        CLR          CLEAR ACC
        LR   1,A     AND SET DEFAULT RESULT
        POP          AND RETURN
*-*-*- Address table for MVC*
TABL    DC   H'0C30'
        DC   H'0C80'
        DC   H'0CD0'
        DC   H'0D20'
        DC   H'0D70'
        DC   H'0DC0'
        DC   H'0F10'
        DC   H'0F60'
*-*-*- To move cursor, uses
*SC0,1,2,3,4,HU,Q,K,W, SC20-24.
CURS    LR   K,P
        PI   PUSH    AND PUSH IT ON TO STACK
MAP0    PI   MWAD    WAIT, THEN UPDATE
        LIS  H'1'    CAN START JOYREAD
        LR   HU,A    SET FOR HORIZONTAL POT
        PI   JOYI    AND READ
        LR   VX,A    SAVE RESULT IN VX
        LIS  H'0'
        LR   HU,A    SET FOR VERTICAL POT
        PI   JOYI
        LR   0,A     SAVE IN REG 0
        PI   AMAP    CONVERT TO PROPER VELOCITY
        LR   VY,A    SAVE RESULT
        LR   A,VX
        LR   0,A     NOW GET UNCOVERTED VX INTO R0
        PI   AMAP    CONVERT IT
        LR   VX,A    AND SAVE IT
        PI   MWAD    WAIT, THEN UPDATE
        PI   BLNK    To blink code (on)
        LIS  H'4'
        LR   0,A
MP01    PI   MWAD    A second wait
        DS   0
        BNZ  MP01
        PI   BLNK    To blink code (off)
        CLR          CLEAR ACC
        XS   VX      VX IN W/STATUS
        BZ   MAP7    NON-NULL X COMPONENT?
        DCI  XPOS    YES
        LM
        LR   X,A     SET CURRENT X POSITION
        LISU 2
        LISL 0
        CLR
        LR   I,A     SP20<=0
        LM
        LR   I,A     SP21<=NON NULL LEAD MASK
        LM
        LR   S,A     SP22<=TRAILING MASK
        CLR
        XS   VX      VX IN W/STATUS
        BM   MAP3    GOING LEFT?
        PI   SHR     SHIFT RIGHT ONE
        LIS  H'7'    NO, GOING RIGHT.
        XS   X
        BNZ  MAP5    IN RH MOST BOX?
        LISL 2       YES
        XS   S
        BZ   MAP5    TRIED TO GO TOO FAR?
MAP2    CLR  YES.
        LR   VX,A    CLEAR X VELOCITY
        BR   MAP7    AND CHECK Y
MAP3    PI   SHL     SHIFT LEFT ONE
        CLR
        XS   X
        BNZ  MAP4    IN LH MOST BOX?
        LISL 0       YES
        XS   S
        BNZ  MAP2    TRIED TO GO TOO FAR?
MAP4    LISL 0
        CLR
        XS   S
        BZ   MAP7    IS SP20 NULL?
        LISL 1       NO.
        LR   A,I
        LR   S,A
        LISL 0
        LR   A,I
        LR   D,A
        CLR
        LR   S,A     SP22<=SP21,SP21<=SP20,SP20<=0,THAT ORDER
        DS   X       AND DECREMENT X COUNT
        BR   MAP7    NOW GO CHECK Y
MAP5    LISL 1
        CLR          CLEAR ACC
        XS   S
        BNZ  MAP7    IS SP21=0?
        LISL 2
        LR   A,D
        LR   I,A
        CLR
        LR   D,A     SP21<=SP22,SP22<=0, THAT ORDER
        LIS  H'1'
        AS   X
        LR   X,A     INCREMENT X COUNT
MAP7    CLR
        XS   VY
        BZ   MAP9    VY=0?
        DCI  YPOS    NO, SET DCO TO LAST Y POSITION
        AM           UPDATE Y COORD
        BM   MP7A    Result Y is neg?
        CI   MAXY    COMPARE W/MAX ALLOWED Y
        BC   MAP8    NEW Y>MAX ALLOWED VALUE?
MP7A    CLR  YES
        LR   VY,A    RESET VY
        BR   MAP9
MAP8    LR   Y,A
MAP9    LR   A,VY    GET VY
        SL   1
        XS   VX
        BZ   MP12    ANY MOVEMENT?
        PI   MVC     YES, REMOVE OLD POSITION
        CLR
        XS   VY
        BZ   MP10    ANY Y MOVEMENT?IF NOT, MUST HAVE VX NE 0
        DCI  YPOS
        LR   A,Y     IS, SO RESET
        ST           Y POSITION
        CLR
        XS   VX
        BZ   MP11    ANY X MOVEMENT?
MP10    DCI  XPOS    UPDATE X POSIT & MASK
        LR   A,X
        ST
        LISL 1
        LR   A,I
        ST
        LR   A,S
        ST
MP11    PI   MVC     DISPLAY NEW POSITION
MP12    CLR
        OUTS 1       Clear port 1
        NOP          3 NOP's for FCC
        NOP          Do not remove
        NOP          for any reason
        INS  1       Get buttons
        NI   H'1'    Strip to desired one
        DCI  BFLG    To button flag
        CLR
        BNZ  MP13    Any button input?
        ST           No, reset edge flag
MP14    JMP  MAP0    And go try again
MP13    LR   Q,DC    Save address
        XM           Flag in W/STATUS
        BNZ  MP14    Previous input?
        LIS  H'1'    No, reset flag
        LR   DC,Q    Recover address
        ST           And reset
CON     CLR
        LR   0,A     Set counter (Y conversion)
CON1    LR   A,Y     Get Y coordinate
        CI   YTST    Compare W/test value
        BC   CON2    Y LE test value?
        LR   A,0     No, increment counter
        INC
        LR   0,A
        LI   -H'A'
        AS   Y
        LR   Y,A     Y<=Y-H'A'
        BR   CON1    Go back and try agian
CON2    LR   A,0     Get counter
        LR   Y,A     Y now↑(0-7):(top-bottom)
        AS   X
        NI   H'1'
        BZ   MP14    On a legal square?
        DCI  COL0    Yes
        CLR
        XM           Flag in W/STATUS
        BP   CON3    Machine plays RED?
        LIS  H'7'    Yes
        XS   Y
        LR   Y,A     Y<=7-Y
        LIS  H'7'
        XS   X
        LR   X,A     X<=7-X
CON3    LR   A,Y
        SR   1
        LR   VY,A    VY reg (BYTENO)<=(1/2*(7-Y)
        DCI  BYDT    To BYTE data
        LR   A,X     Get X coord.
        ADC          Add offset to base address
        LM           Get byte
        LR   VX,A    Save byte into VX reg
        DCI  XOLD
        LR   A,X
        ST
        LR   A,Y
        ST           SAVE CONVERTED CO-ORDINATES
        PI   MWAD    WAIT, THEN UPDATE
        PI   ENIN    ENABLE INTERRUPT DRIVEN UPDATE
        PI   POPS    POP RETURN ADDRESS
        PK           AND RETURN
*-*-*- Data for byte values (X coord. conversions)
BYDT    DC   H'0880'
        DC   H'0440'
        DC   H'0220'
        DC   H'0110'
*-*-*- MVC Set or remove cursor
MVC     LR   K,P   SAVE RETURN ADDRESS
        DCI  XPOS
        LM
        LR   0,A     SAVE X IN R0
        LISU 2
        LISL 3
        LM
        LR   I,A
        LM
        LR   D,A     LEAD IN SP23,TRAIL IN SP24
        CI   YPOS
        LM           GET Y COORDINATE
        DCI  H'0C30' DCO TO OBJ0 BASE ADDRESS
        ADC          ADD 8 X Y COORD (W/MAX FOR Y
        ADC          OVER H'40', CANNOT USE "CUTE"
        ADC          TRICKS HERE--AND FOR SPEED,
        ADC          WE JUST USE STRAIGHT ADC'S).
        ADC
        ADC
        ADC
        ADC
        LR   A,0     GET X OFFSET
        ADC          AND ADD IT IN
        LIS  CHT
        LR   0,A     SET COUNT FOR TRANSFER
MVC1    LR   Q,DC    SAVE ADDRESS IN Q REG
        LR   A,QU    GET HO ADDRESS
        CI   H'E'
        BNZ  MVC2    AT BOTTOM OF OBJ0
        LR   A,QL    DEFINITELY.
        CI   H'F'
        BC   MVC2    PAST BOTTOM?
        LIS  H'F'    YES.
        LR   QU,A    RESET HO ADDRESS
        LR   DC,Q    AND RESET DCO ACCORDINGLY (FOR OBJ1)
MVC2    LR   A,I     GET LEAD MASK BYTE
        LR   Q,DC    SAVE DCO
        XM           XOR IN CURSOR
        LR   DC,Q    RECOVER ADDRESS
        ST           AND RESET THAT BYTE
        LR   Q,DC    SAVE ADDRESS AGAIN
        LR   A,D     GET TRAILING MASK BYTE
        XM           XOR IN BITS
        LR   DC,Q    RECOVER ADDRESS
        ST           AND RESET DATA
        LIS  H'6'
        ADC          SET TO NEXT DESTINATION
        DS   0       DECREMENT COUNTER
        BNZ  MVC1    DONE?
        PK           YES, RETURN
*-*-*- AMAP Mapping joystick readings to velocities
AMAP    LR   A,0     GET READING
        CI   H'40'
        BNC  AMP1    VAL LE H'1'?
        LI   H'FF'   YES.
        BR   AMP2
AMP1    CI   H'C0'
        CLR
        BC   AMP2    VAL GT 197?
        LIS  H'1'    YES, VELOCITY = 1
AMP2    POP          RETURN
*-*-*- BLNK  Blinking routine
BLNK    LR   K,P
        DCI  BLNF    Test BLINK flag
        CLR
        XM
        BZ   BLN4    Need to blink?
        LISU 2
        LISL 3
        LM           Yes
        LR   I,A     Get X value
        LM
        LR   D,A     and Y value to blink
        DCI  COL0
        CLR
        XM
        BZ   BLN0    Need to reverse?
        LIS  H'7'
        XS   S
        LR   I,A
        LIS  H'7'
        XS   S
        LR   D,A
BLN0    DCI  H'0C30'-H'50' DC0 TO OBJ0-H'50'
        LISL 4
        LIS  H'5'
        SL   4
BLN1    ADC          Add off-set
        DS   S
        BP   BLN1    Added enough?
        LR   Q,DC    Yes
        LR   A,QU    Get H0 address
        CI   H'E'
        BNZ  BLN2    Need reset?
        LIS  H'F'    Yes
        LR   QU,A
BLN2    LR   DC,Q
        LISL 3
        LR   A,S
        ADC          Add off-set
        LIS  H'3'
        LR   0,A     Set counter
BLN3    LR   Q,DC
        LI   H'C0'
        XM
        LR   DC,Q
        ST
        LIS  H'7'
        ADC          Next one to blink
        DS   0       Decrement counter
        BNZ  BLN3    Done?
BLN4    PK
INIT    DC   H'30'
        DC   H'10'   OBJ1 L.O. RP
        DC   H'5F'   TEXT LOW ORDER ROM
        DC   H'8C'   OBJ0 H.O.RP+COLOR
        DC   H'8F'   OBJ1 H.O.RP
        DC   H'EE'
        DC   H'48'   OBJ0 DELTA X ---
        DC   H'48'   OBJ1 DELTA X---
        DC   H'70'   TEXT OBJECT DELTA X
TY0     DC   H'3C'   OBJ0 DELTA Y ----
        DC   H'14'   OBJ1 DELTA Y ---
        DC   H'07'   TEXT OBJECT DELTA Y
        DC   H'0D'   OBJ0-X-CO
        DC   H'0D'   OBJ1 X-CO
        DC   H'1C'   TEXT OBJECT X COORD
        DC   H'48'   OBJ0 Y-VALUE L.O.A
        DC   H'C0'   OBJ1 Y-VALUE L.O.A
        DC   H'26'   TEXT OBJECT Y VAL LO A
        DC   H'00'   OBJ0 Y-VALUE H.0 &X-ORDER
        DC   H'01'   OBJ1- Y-VAL H.O.$X-ORDER
        DC   H'82'   TEXT OBJ INITIALLY OFF
UDIT    DC   H'30'
        DC   H'10'
        DC   H'5F'
        DC   H'8C'
        DC   H'8F'
        DC   H'EE'
        DC   H'3C'
        DC   H'14'
        DC   H'07'
TAB1    DC   H'0F10' BYTE 3
        DC   H'0D70' BYTE 2
        DC   H'0CD0' BYTE 1
        DC   H'0C30' BYTE 0
TAB2    DC   D'86'   RELATIVE SQUARE POSITION TABLE
        DC   D'84'
        DC   D'82'
        DC   D'80'
        DC   D'07'
        DC   D'05'
        DC   D'03'
        DC   D'01'
KING    DC   B'01011010' KING'S CROWN
        DC   B'00111100'
        DC   B'00011000'
REDP    DC   B'00111100' RED PIECE
        DC   B'01111110'
        DC   B'01111110'
        DC   B'01111110'
        DC   B'00111100'
BLKP    DC   B'00111100' BLACK PIECE
        DC   B'01000010'
        DC   B'01000010'
        DC   B'01000010'
        DC   B'00111100'
*-*-*- YMF
YMF     DC   H'0513' Y0
        DC   H'0300' U-
        DC   H'2913' MO
        DC   H'2F0B' VE
        DC   H'00'   -
        DC   H'1D'   F
        DC   H'0109' IR
        DC   H'2107' ST
        DC   H'00'   -
        DC   H'35'   ?
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'0500' Y-
        DC   H'1309' OR
        DC   H'00'   -
        DC   H'2B'   N
*-*-*-*-*-*-*-*-*-*-*-*-*-
*-*-*- SKL Skill text
SKL     DC   H'3119' CH
        DC   H'1313' OO
        DC   H'210B' SE
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'150B' KE
        DC   H'0500' Y-
        DC   H'00'   -
        DC   H'00'   -
        DC   H'112D' AB
        DC   H'0B00' E-
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'11'   A
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
DICK    DC   H'2D0B' BE
        DC   H'0707' TT
        DC   H'05'   Y
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'2D'   B
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
HARY    DC   H'3119' CH
        DC   H'1109' AR
        DC   H'2701' LI
        DC   H'0B'   E
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'31'   C
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
        DC   H'00'   -
*MWAD*-WAIT, THEN UPDATE, AND KEEP THE*
*-*-*-*X ZOOM BIT SET PROPERLY DURING *
*-*-*-*DISPLAY MAINTENANCE.*-*-*-*-*-*-
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
MWAD    LR   K,P     SAVE RETURN ADDRESS
        PI   PUSH    AND PUSH ONTO STACK
        PI   DAI     Disable interrupts
        PI   WAIT    WAIT ON APPROPRIATE LINE
        DCI  CMRG    DCO TO PROG COPY COMREG
        LI   MSK     MASK IN
        XM           TURN OFF XZOOM
        DCI  H'8F7'  IN THE UM1 COPY
        ST           ONLY
        PI   UDAT    NOW DO UPDATE
        LI   XZOP    SET LINE FOR RESTORE XZOOM
MWD1    DCI  H'8FB'  DCO TO CURRENT LINE
        CM           COMPARE
        BNZ  MWD1    REACHED IT YET?
        DCI  CMRG    YES
        LM
        DCI  H'8F7'  NOW RESET UM1 COPY
        ST
        PI   POPS    POP RETURN ADDRESS
        PK           AND RETURN
*-*-*- Interrupt enable for update
ENIN    LI   INHR:
        OUTS H'C'
        LI   INHR.
        OUTS H'D'    SET INTERRUPT VECTOR
        DCI  H'8F0'
        LI   ULIN
        ST           SET INTERRUPT LINE
        DCI  CMRG    DCO TO PROG COPY COMREG
        LR   Q,DC    SAVE ADDRESS IN Q RES
        LIS  H'8'
        OM
        LR   DC,Q
        ST           IN PROGRAM COPY
        DCI  H'8F7'
        ST           DITTO UM1 COPY
        LIS  H'1'
        OUTS H'E'    ENABLE SMI...
        EI           ENABLE CPU
        LR   J,W     SAVE SAME STATUS
        POP          AND RETURN
*-*-*- Interrupt disable
DAI     DI           DISABLE CPU INTERRUPT
        LR   J,W     SET J ACCORDINGLY
        DCI  CMRG    DCO TO PROG COPY COMREG
        LR   Q,DC    SAVE ADDRESS
        LIS  H'8'
        COM
        NM           TURN OFF BIT
        LR   DC,Q    IN THE
        ST           PROGRAM COPY,
        DCI  H'8F7'
        ST           AND THE UM1 COPY
        CLR
        OUTS H'E'    NOW DISABLE SMI
        POP          AND RETURN
*-*-*- SCRD  SC to RAM direct
SCRD    LR   K,P     SC TO RAM direct
        LISU PLOC
        LISL 0
SCD1    LR   A,I
        ST
        BR7  SCD1
        LR   A,I
        ST
        LISU KLOC
SCD2    LR    A,I
        ST
        BR7  SCD2
        LR   A,I
        ST
        PK
*-*-INHR Interrupt handler, saves and restores data
INHR    LR   8,A     SAVE ACC
        LR   A,IS
        LISU 6
        LISL 0
        LR   I,A     SAVE ISAR IN REG O'60'
        LR   A,HU
        LR   I,A     SAVE HU IN REG O'61'
        LR   A,HL
        LR   I,A     SAVE HL IN REG O'62'
        LR   A,J
        LR   I,A     SAVE J REG IN REG O'63'
        LR   H,DC    SAVE OLD DCO
        DCI  RGSV    DCO TO SAVE AREA START
        LR   A,HU
        ST
        LR   A,HL
        ST           SAVE OLD DCO IN RGSV,RGSV+1
        XDC
        LR   H,DC
        XDC
        LR   A,HU
        ST
        LR   A,HL
        ST           SAVE OLD DC1 IN RGSV+2,RGSV+3
        LR   A,KU
        ST
        LR   A,KL
        ST           SAVE K REG IN RGSV+4,RGSV+5
        LR   K,P     PC1 INTO K REGISTER
        LR   A,KU
        ST
        LR   A,KL
        ST           PC1 INTO RGSV+6,RGSV+7
        LR   J,W     SAVE OLD STATUS
        LISU 2
        LISL 3
INH2    LR   A,D
        ST           SP23,22,21,20 IN, RESP.
        BR7  INH2    RGSV+8,+9,+A,+B
        DCI  CMRG    DCO TO COMMAND REGISTER
        LI   MSK     MASK ON
        XM           TURN OFF X ZOOM BIT
        DCI  H'8F7'  IN THE UM1
        ST           COMMAND REGISTER
        PI   UDAT    UPDATE UM1 DISPLAY REGISTERS
        LI   XZOP    SET LINE FOR XZOOM ON
INH1    DCI  H'8FB'  DCO TO CURRENT Y LO
        CM           COMPARE
        BNZ  INH1    DIFFERENT?
        DCI  CMRG    NO. RESTORE X ZOOM
        LM           FROM OLD COPY
        DCI  H'8F7'  TO THE UM1 COPY
        ST
*
* RESTORE ALL REGISTERS
*
        DCI  RGSV    DCO TO SAVE AREA
        LM
        LR   HU,A
        LM
        LR   HL,A    OLD DCO TO H REG
        XDC
        LR   DC,H    NOW INTO DCO
        XDC          AND INTO DC1
        LM
        LR   HU,A
        LM
        LR   HL,A    OLD DC1 INTO H REGISTER
        LIS  H'2'
        ADC          BYPASS K FOR A MOMENT
        LM
        LR   KU,A
        LM
        LR   KL,A
        LR   P,K     RESTORE PC1
        LISU 2
        LISL 3
INH3    LM           RESTORE SP20-23 FROM
        LR   D,A     RGSV+8,+9,+A,+B
        BR7  INH3
        DCI  RGSV+4
        LM
        LR   KU,A
        LM
        LR   KL,A    RESTORE K REGISTER
        LR   DC,H    RESTORE DC1
        XDC          AND SET DCO&DC1 PROPERLY
        LR   W,J     NOW RESTORE STATUS AT ENTRY
*
* NOW RESTORE J,H,A FROM SCRATCH PAD
*
        LISU 6
        LISL 3
        LR   A,D     GET J
        LR   J,A
        LR   A,D     GET HL
        LR   HL,A
        LR   A,D
        LR   HU,A    RESTORE HU
        LR   A,D     GET ISAR
        LR   IS,A    RESTORE ISAR
        LR   A,8     RESTORE A
        EI           INT. ENABLE
        POP
*DEBUGING AID*-*-TEMPORARY ONLY!
*-*-*-*-*-*-*-*-*-*-*-*-*-*
SHOW    LR   K,P     SAVE RETURN ADDRESS
        PI   PUSH    AND PUSH ONTO STACK
        DCI  CMRG    DCO TO PROG COPY OF COMMAND REG
        LM           GET SAME
        DCI  H'8F7'  DCO TO UM1 COPY OF SAME
        ST           RESET UM1 FROM PROG COPY
        DCI  COL0
        LR   A,7
        CM           COMPARE PLAYER W/BLACK PLAYER FLAG
        BNZ  SH3     WANT TO DISPLAY BOARD?
SH2     PI   POPS    NO, POP RETURN ADDRESS
        PK           AND RETURN
SH3     PI   BORD    DISPLAY BOARD FIRST
        DCI  HSAV    THEN DCO TO HSAVE AREA
        LR   A,HU
        ST
        LR   A,HL
        ST           AND SAVE THE H REGISTER
        SR   4       GET HO NIBBLE OF HL
        SL   1       MULT BY 2 FOR INDEX INTO TABLE
        DCI  ADTB    DCO TO CHARACTER ADDRESS TABLE
        ADC          ADD OFFSET FOR HL HO NIBBLE
        LM
        LR   HU,A
        LM
        LR   HL,A    AND GET ADDRESS OF CHAR.INTO H
        DCI  OBJ0    DCO TO DEST START
        XDC          SAVE DEST IN DC1
        LR   DC,H    SOURCE INTO DCO
        LIS  H'7'    SET TRANSFER
        LR   HU,A    COUNT IN HU
SH4     LM           GET SOURCE BYTE
        XDC          NOW GET DEST. ADDRESS
        ST           AND STORE
        LIS  H'7'
        ADC          ADD OFFSET TO NEXT DEST.
        XDC          SOURCE INTO DCO, DEST IN DC1
        DS   HU      DECREMENT COUNTER
        BNZ  SH4     DONE?
        DCI  HSAV    YES
        LM           GET H REGISTER
        LR   HU,A    BACK TO ITS
        LM           ORIGINAL
        LR   HL,A    STATE
        BR   SH2     AND RETURN
*-*-*-*-*-*-*-*-*-*-*
*ADDRESS TABLE FOR  *
*DIGIT CHARACTERS   *
*-*-*-*-*-*-*-*-*-*-*
ADTB    DC   H'218A' 0 ADDRESS
        DC   H'210C' 1 ADDRESS
        DC   H'217C' 2 ADDRESS
        DC   H'216E' 3 ADDRESS
        DC   H'20FE' 4 ADDRESS
        DC   H'20F0' 5 ADDRESS
        DC   H'20E2' 6 ADDRESS
        DC   H'2072' 7 ADDRESS
        DC   H'2064' 8 ADDRESS
        DC   H'2056' 9 ADDRESS
        DC   H'2087' A ADDRESS
        DC   H'214B' B ADDRESS
        DC   H'2167' C ADDRESS
        DC   H'20E9' D ADDRESS
        DC   H'205D' E ADDRESS
        DC   H'20DB' F ADDRESS
*
SEE     LR      K,P             See where it loops
        DCI     H'0EE0'         Save data here
        LIS     H'3'            3 items per entry
        AM
        CI      H'C'            Is there room?
        BP      SEE2            Yes
        CLR                     Start over
SEE2    DCI     H'0EE0'
        ST
        ADC
        LR      A,KU            Where we came from
        ST
        LR      A,KL
        ST
        LR      A,HL            And the H value
        ST
        PK
        END          END FOR ASSEMBLER